@@ -1,3 +1,6 @@
+[0.012] Thu Apr 1 21:03:30 CEST 2010
+ - fixed query parameter handling
+
[0.011] Sun Oct 11 20:18:19 CEST 2009
- fixed broken isa RenderView test case
- parameterized roles now available
@@ -26,7 +26,7 @@ no_index:
provides:
CatalystX::Declare:
file: lib/CatalystX/Declare.pm
- version: 0.011
+ version: 0.012
CatalystX::Declare::Keyword::Action:
file: lib/CatalystX/Declare/Keyword/Action.pm
CatalystX::Declare::Keyword::Application:
@@ -63,4 +63,4 @@ resources:
bugtracker: http://github.com/phaylon/catalystx-declarative/issues
license: http://dev.perl.org/licenses/
repository: http://github.com/phaylon/catalystx-declarative/tree/master
-version: 0.011
+version: 0.012
@@ -2,6 +2,7 @@ use MooseX::Declare;
role CatalystX::Declare::Action::CatchValidationError {
+ use MooseX::Types::Moose qw( ArrayRef Str HashRef );
use aliased 'Moose::Meta::TypeConstraint';
has method_type_constraint => (
@@ -12,12 +13,59 @@ role CatalystX::Declare::Action::CatchValidationError {
},
);
+ has method_named_params => (
+ is => 'rw',
+ isa => ArrayRef[Str],
+ );
+
+ has method_named_type_constraint => (
+ is => 'rw',
+ isa => HashRef[TypeConstraint],
+ );
+
has controller_instance => (
is => 'rw',
isa => 'Catalyst::Controller',
weak_ref => 1,
);
+ method extract_named_params (Object $ctx) {
+
+ my %extracted;
+ my $tcs = $self->method_named_type_constraint;
+
+ if (my $named = $self->method_named_params) {
+
+ for my $key (@$named) {
+
+ my $value = $ctx->request->params->{ $key };
+ my $tc = $tcs->{ $key };
+
+ if ($tc and $tc->is_subtype_of(ArrayRef)) {
+
+ $value = []
+ unless exists $ctx->request->params->{ $key };
+
+ $value = [$value]
+ unless is_ArrayRef $value;
+ }
+ else {
+
+ next unless exists $ctx->request->params->{ $key };
+ }
+
+ $extracted{ $key } = $value;
+ }
+ }
+
+ return \%extracted;
+ }
+
+ around execute (Object $ctrl, Object $ctx, @rest) {
+
+ return $self->$orig($ctrl, $ctx, @rest, %{ $self->extract_named_params($ctx) });
+ }
+
around match (Object $ctx) {
return
@@ -27,7 +75,8 @@ role CatalystX::Declare::Action::CatchValidationError {
my @args = ($self->controller_instance, $ctx, @{ $ctx->req->args });
my $tc = $self->method_type_constraint;
- my $ret = $self->_check_action_arguments(\@args);
+ my $np = $self->extract_named_params($ctx);
+ my $ret = $tc->_type_constraint->check([\@args, $np]);
return $ret;
}
@@ -27,6 +27,16 @@ role CatalystX::Declare::Controller::ActionPreparation {
};
}
+ method _find_method_named_params (Str $name) {
+
+ return $self->meta->find_method_named_params($name);
+ }
+
+ method _find_method_named_type_constraint (Str $method, Str $param) {
+
+ return $self->meta->find_method_named_type_constraint($method, $param);
+ }
+
method _ensure_applied_dispatchtype_roles {
my $type = $self->_app->dispatcher->dispatch_type('Chained');
@@ -68,12 +78,22 @@ role CatalystX::Declare::Controller::ActionPreparation {
unless $action->DOES(CatchValidationError);
my $tc = $self->_find_method_type_constraint($action->name);
+ my $np = $self->_find_method_named_params($action->name);
return $action
unless $tc;
- $action->method_type_constraint($tc);
$action->controller_instance($self);
+ $action->method_type_constraint($tc);
+
+ if ($np) {
+
+ $action->method_named_params($np);
+ $action->method_named_type_constraint({
+ map +($_, $self->_find_method_named_type_constraint($action->name, $_)),
+ @$np,
+ });
+ }
return $action;
}
@@ -3,7 +3,7 @@ use MooseX::AttributeHelpers;
role CatalystX::Declare::Controller::Meta::TypeConstraintMapping {
- use MooseX::Types::Moose qw( HashRef Object );
+ use MooseX::Types::Moose qw( HashRef Object ArrayRef Str CodeRef );
use aliased 'Moose::Meta::TypeConstraint';
use aliased 'MooseX::Method::Signatures::Meta::Method', 'MethodWithSignature';
@@ -20,10 +20,42 @@ role CatalystX::Declare::Controller::Meta::TypeConstraintMapping {
},
);
+ has method_named_param_map => (
+ metaclass => 'Collection::Hash',
+ is => 'ro',
+ isa => HashRef[ArrayRef[Str]],
+ required => 1,
+ lazy_build => 1,
+ provides => {
+ get => 'get_method_named_params',
+ set => 'set_method_named_params',
+ },
+ );
+
+ has method_named_type_constraint_map => (
+ metaclass => 'Collection::Hash',
+ is => 'ro',
+ isa => HashRef[HashRef[Object]],
+ required => 1,
+ lazy_build => 1,
+ provides => {
+ get => 'get_method_named_type_constraint',
+ set => 'set_method_named_type_constraint',
+ },
+ );
+
method _build_method_type_constraint_map {
return +{};
}
+ method _build_method_named_type_constraint_map {
+ return +{};
+ }
+
+ method _build_method_named_param_map {
+ return +{};
+ }
+
around add_method ($method_name, $method) {
if (is_Object $method and $method->isa(MethodWithSignature)) {
@@ -34,20 +66,67 @@ role CatalystX::Declare::Controller::Meta::TypeConstraintMapping {
$method_name,
$tc,
);
+
+ if ($method->parsed_signature->has_named_params) {
+ my $named = $method->parsed_signature->named_params;
+
+ $self->set_method_named_params(
+ $method_name,
+ [ map $_->label, @$named ],
+ );
+ $self->set_method_named_type_constraint(
+ $method_name,
+ { map +($_->label, $_->meta_type_constraint), @$named },
+ );
+ }
}
return $self->$orig($method_name, $method);
}
- method find_method_type_constraint (Str $name) {
+ method _find_capable_classes (CodeRef $test) {
- my @parents =
- grep { $_->can('get_method_type_constraint') }
+ return
+ grep { local $_ = $_; $_->$test }
+ $self,
map { $_->meta }
grep { $_->can('meta') }
$self->linearized_isa;
+ }
+
+ method find_method_named_params (Str $name) {
+
+ my @parents = $self->_find_capable_classes(sub { $_->can('get_method_named_params') });
+
+ for my $isa (@parents) {
+
+ if (my $named = $isa->get_method_named_params($name)) {
+ return [@$named];
+ }
+ }
+
+ return undef;
+ }
+
+ method find_method_named_type_constraint (Str $method, Str $param) {
+
+ my @parents = $self->_find_capable_classes(sub { $_->can('get_method_named_type_constraint') });
+
+ for my $isa (@parents) {
+
+ if (my $named = $isa->get_method_named_type_constraint($method)) {
+ return $named->{ $param };
+ }
+ }
+
+ return undef;
+ }
+
+ method find_method_type_constraint (Str $name) {
+
+ my @parents = $self->_find_capable_classes(sub { $_->can('get_method_type_constraint') });
- for my $isa ($self, @parents) {
+ for my $isa (@parents) {
if (my $tc = $isa->get_method_type_constraint($name)) {
return $tc;
@@ -27,9 +27,10 @@ role CatalystX::Declare::Dispatching::ChainTypeSensitivity {
my $tc = $action->method_type_constraint;
my $ctrl = $action->controller_instance;
+ my $np = $action->extract_named_params($ctx);
return ()
- unless $tc->check([$ctrl, $ctx, @action_parts]);
+ unless $tc->_type_constraint->check([[$ctrl, $ctx, @action_parts], $np]);
}
$self->$orig($ctx, $parent, $path_parts);
@@ -658,6 +658,10 @@ Named parameters will be populated with the values in the query parameters:
# /view/17/?page=3
final action view (Int $id, Int :$page = 1) under '/';
+If you specify a query parameter to be an C<ArrayRef>, it will be specially
+handled. For one, it will match even if there is no such value in the
+parameters. Second, it will always be wrapped as an array reference.
+
Your end-points can also take an unspecified amount of arguments by specifying
an array as a variable:
@@ -10,7 +10,7 @@ class CatalystX::Declare extends MooseX::Declare is dirty {
clean;
- our $VERSION = '0.011';
+ our $VERSION = '0.012';
around keywords (ClassName $self:) {
$self->$orig,
@@ -9,10 +9,28 @@ use lib "$FindBin::Bin/lib";
use Test::More;
use Catalyst::Test 'TestApp';
+use HTTP::Request::Common;
is get('/sigmatch/test/23'), 'signaturematching/int', 'integer argument dispatched correctly';
is get('/sigmatch/test/foo'), 'signaturematching/str', 'string argument dispatched correctly';
is get('/sigmatch/test/f00'), 'signaturematching/rest', 'no match leads to other dispatched action';
+is get('/sigmatch/opt_param?page=3'), 'page 3', 'query parameter';
+is get('/sigmatch/opt_param?page=9&other=foo'), 'page 9', 'additional query parameter';
+
+is get('/sigmatch/req_param?page=7'), 'page 7', 'required query parameter';
+is get('/sigmatch/req_param'), 'no page', 'required query parameter fallback';
+
+# TODO
+#is get('/sigmatch/mid?page=3'), 'signaturematching/end_with_param', 'mid point with query parameter';
+#is get('/sigmatch/mid'), 'signaturematching/end_no_param', 'mid point without query parameter';
+
+is get('/sigmatch/with_list?filter=3'), '3', 'list-forced query parameter';
+is get('/sigmatch/with_list'), '', 'list-forced empty query parameter list';
+is get('/sigmatch/with_list?filter=3&filter=5'), '3, 5', 'list-forced query parameter with multiple';
+is get('/sigmatch/with_list?filter=foo'), 'signaturematching/rest', 'invalid data in list-forced query';
+
+is request(POST '/sigmatch/getpost', [id => 7])->content, 7, 'post request';
+
done_testing;
@@ -25,7 +25,8 @@ controller ::Controller::Foo with ::TestRole {
around execute ($controller, $ctx, @args) {
my $page = $ctx->request->params->{page} || 1;
- return $self->$orig($controller, $ctx, @args, page => $page);
+ $ctx->stash(page => $page);
+ return $self->$orig($controller, $ctx, @args);
}
}
@@ -180,10 +181,10 @@ controller ::Controller::Foo with ::TestRole {
$ctx->stash(title => $title);
}
- action view (Str $format, Int :$page) under book isa Page is final {
+ action view (Str $format) under book isa Page is final {
$ctx->response->body(
sprintf 'Page %d of "%s" as %s',
- $page,
+ $ctx->stash->{page},
$ctx->stash->{title},
uc($format),
);
@@ -19,5 +19,36 @@ controller TestApp::Controller::SignatureMatching {
final action rest (@)
as '' { $self->mark($ctx) }
+
+
+ final action opt_param (Int :$page?) {
+ $ctx->response->body("page $page");
+ }
+
+
+ final action req_param (Int :$page!) {
+ $ctx->response->body("page $page");
+ }
+
+ final action req_param_none as req_param {
+ $ctx->response->body('no page');
+ }
+
+
+ # TODO
+ action mid_with_param (Int :$page!) as '';
+ action mid_no_param as '';
+ final action end_with_param under mid_with_param as mid { $self->mark($ctx) }
+ final action end_no_param under mid_no_param as mid { $self->mark($ctx) }
+
+
+ final action with_list (ArrayRef[Int] :$filter) {
+ $ctx->response->body(join ', ', sort @$filter);
+ }
+
+
+ final action getpost (Int :$id) {
+ $ctx->response->body($id);
+ }
}
}